home *** CD-ROM | disk | FTP | other *** search
/ Eagles Nest BBS 8 / Eagles_Nest_Mac_Collection_Disc_8.TOAST / Developer Tools⁄Additions / InsideBa1994 / InsideBasic-94 / IB 94 / Banner / Banner.BAS
BASIC Source File  |  1994-01-20  |  9KB  |  243 lines
  1. ' Banner Spanner
  2. ' Richard B. Bartlett
  3. ' © Copyright 1990, Bartlett, Bradley & Lucky
  4. ' All rights reserved
  5. '_____________________________________________________________________________
  6.  
  7. ' Configure Options for ZBasic 5.0x
  8. '   Default variable Type:              Integer
  9. '   Optimize expressions as Integer:    On
  10. '   Space Req. After Key Words:         On
  11. '   All other options:                  Off
  12. '_____________________________________________________________________________
  13.  
  14. WINDOW OFF
  15. COORDINATE WINDOW
  16.  
  17. true = NOT false
  18.  
  19. ON BREAK  GOSUB "Break"
  20. ON DIALOG GOSUB "Dialog"
  21. ON MENU   GOSUB "Menu"
  22.  
  23. GOSUB "Startup"
  24.  
  25. DO
  26.   DIALOG ON:  MENU ON
  27.   DIALOG OFF: MENU OFF
  28.   IF printNow THEN GOSUB "Print"        :         ' Print if flag is set
  29. UNTIL done                              :         ' Quit if flag is set
  30.  
  31. END
  32. '_____________________________________________________________________________
  33.  
  34. "Dialog"
  35.  
  36. myEvent = DIALOG(0)
  37. which = DIALOG(myEvent)
  38.  
  39. SELECT myEvent
  40.   CASE 1,6                            :           ' Click in button or Return pressed
  41.     printNow = true                   :           '   Set flag indicating desire to print
  42.   CASE 5                              :           ' Window refresh needed
  43.     GOSUB "Refresh1"                  :           '   Refresh main window
  44. END SELECT
  45.  
  46. RETURN
  47. '_____________________________________________________________________________
  48.  
  49. "Menu"
  50.  
  51. menuId = MENU(0)
  52. itemId = MENU(1)
  53.  
  54. SELECT menuId
  55.   CASE 1                              :           ' File menu
  56.     SELECT itemId
  57.       CASE 1                          :           '   Page Setup
  58.         DEF PAGE
  59.         MENU
  60.       CASE 2                          :           '   Print
  61.         printNow = true               :           '     Set Print flag
  62.       CASE 4                          :           '   Quit
  63.         done     = true               :           '     Set Quit Program flag
  64.     END SELECT
  65. END SELECT
  66.  
  67. RETURN
  68. '_____________________________________________________________________________
  69.  
  70. "Break"
  71.  
  72. abortPrint = true                     :           '   Set Quit Printing flag
  73.  
  74. RETURN
  75. '_____________________________________________________________________________
  76.  
  77. "Startup"
  78.  
  79. t = 3: l = 366: b =  31: r = 434      :           ' Rectangle to frame button
  80. DIM fAscent,fDecent,fWidth,fLeading   :           ' FontInfo record
  81. plain   = 0: bold   =  1: italic   =  2: underline =  4   :' Available
  82. outline = 8: shadow = 16: condense = 32: extended  = 64   :' text modes
  83.  
  84. MENU 1,0,1,"File"
  85. MENU 1,1,1,"Page Setup…"
  86. MENU 1,2,1,"P/Print…"
  87. MENU 1,4,1,"Q/Quit"
  88.  
  89. DIALOG ON                             :           ' Multifinder kluge to force our
  90. DIALOG OFF                            :           ' window to front position
  91.  
  92. WINDOW     1,  "Banner Spanner",( 10,50)-(502,130),261
  93. EDIT FIELD 1,  "",              (  8,35)-(484, 70)
  94. BUTTON     1,1,"Print",         (370, 7)-(430, 27)
  95.  
  96. RETURN
  97. '_____________________________________________________________________________
  98.  
  99. LONG FN Boxer                           :         ' Draw a box around our Banner
  100.   top    = rPageT
  101.   left   = rPageL - (currentPage - 1) * pageWid + 20
  102.   bottom = rPageB
  103.   right  = left + stringLen + 104
  104.   BOX left,top TO right,bottom
  105. END FN
  106.  
  107. LONG FN MyText(num,siz,fac,mde)         :         ' Replaces ZBasic TEXT statement
  108.   CALL TEXTFONT(num)                    :         '   to avoid extra page eject
  109.   CALL TEXTSIZE(siz)                    :         '   from ImageWriter
  110.   CALL TEXTFACE(fac)
  111.   CALL TEXTMODE(mde)
  112. END FN
  113. '_____________________________________________________________________________
  114.  
  115. "Print"
  116.  
  117. printNow = false                      :           ' Reset Print Now flag
  118. banner$  = EDIT$(1)                   :           ' Get the string to be printed
  119. FLUSHEVENTS
  120.  
  121. LONG IF LEN(banner$) = 0              :           ' If the string is empty, alert user
  122.   temp$ = "There is no text to print!"
  123.   CALL PARAMTEXT(temp$,"","","")
  124.   dummy = FN CAUTIONALERT(1,0)
  125.   MENU
  126.   RETURN
  127. END IF
  128.  
  129. DEF LPRINT
  130.  
  131. LONG IF NOT PRCANCEL
  132.   CURSOR 4                            :           ' Use the Watch cursor
  133.   abortPrint = false                  :           ' Clear CANCEL Printing flag
  134.   
  135.   GOSUB "PrintRec"                    :           ' Check out the Print Record
  136.   GOSUB "FontInfo"                    :           ' Prepare to print the Banner
  137.   
  138.   pages = stringLen / pageWid         :           ' Calculate pages needed for Banner
  139.   IF pages * pageWid < stringLen THEN pages = pages + 1 :' Round up if needed
  140.   
  141.   startPage = iFstPage                :           ' Get 1st page to print
  142.   endPage   = iLstPage                :           ' Get last page to print
  143.   
  144.   IF startPage > 1 THEN POKE WORD PEEK LONG(PRHANDLE) + 62,1 :' Tell printer
  145.   :                                               ' we are starting with the first page
  146.   LONG IF endPage = 9999              :           ' If default value then
  147.     endPage = pages                   :           '   print to last page
  148.   XELSE                               :           ' otherwise
  149.     POKE WORD PEEK LONG(PRHANDLE) + 64,9999 :     ' tell printer all pages
  150.   END IF
  151.   
  152.   WINDOW 2,"printing",(100,100)-(412,200),4 :     ' Printing progress window
  153.   
  154.   FOR currentPage = startPage TO endPage    :     ' For each page to be printed
  155.     
  156.     BREAK ON                                :     '   Check for CANCEL printing
  157.     BREAK OFF
  158.     
  159.     LONG IF abortPrint = false              :     ' If not CANCELed
  160.       LONG IF currentPage <= pages          :     '   If not past last page
  161.         GOSUB "Refresh2"                    :     '     Update the Progress window
  162.         ROUTE 128                           :     '     Route output to printer
  163.         FN Boxer                            :     '     Draw box around Banner
  164.         FN MyText(fNum,fHeight,face,1)      :     '     Set font,size,face & mode
  165.         CALL MOVETO(72 -(currentPage - 1) * pageWid,fAscent - fLeading)
  166.         :                                         '     Offset Banner location
  167.         CALL DRAWSTRING(banner$)            :     '     Print the Banner
  168.         ROUTE 0                             :     '     Route output to screen
  169.         CLOSE LPRINT                        :     '     Close the printer driver
  170.       END IF
  171.     END IF
  172.     
  173.   NEXT
  174.   
  175.   WINDOW CLOSE 2                      :           ' Close Printing Progress window
  176.   CURSOR 0                            :           ' Use arrow cursor
  177. END IF
  178.  
  179. MENU
  180.  
  181. RETURN
  182. '_____________________________________________________________________________
  183.  
  184. "Refresh1"                              :         ' Fill in the Main window
  185.  
  186. TEXT 4,9,0,0                          :           ' 9 pt Monaco
  187. PRINT %(60,20) "Please enter the text for your banner…"
  188.  
  189. PEN 3,3
  190. CALL FRAMEROUNDRECT(t,16,16)          :           ' Frame the "Print" button
  191. CALL PENNORMAL
  192.  
  193. RETURN
  194. '_____________________________________________________________________________
  195.  
  196. "Refresh2"                              :         ' Fill in the "Printing" window
  197.  
  198. TEXT 0,12,0,0                         :           ' 12 pt Chicago
  199. PRINT @(2,1) "Printing page";currentPage;"of your banner…  "
  200.  
  201. temp$ = "Press " + CHR$(17) + " and " + CHR$(34) + "." + CHR$(34)
  202. temp$ =  temp$ + " to CANCEL."
  203. PRINT @(5,3) temp$                    :           ' Tell user how to cancel printing
  204.  
  205. RETURN
  206. '_____________________________________________________________________________
  207.  
  208. "PrintRec"
  209.  
  210. pRec&    = USR 3(PRHANDLE)            :           ' Lock handle to print record (TPrint)
  211. rPageT   = PEEK WORD(pRec& +  8)      :           ' Paper rectangle (printable area)
  212. rPageL   = PEEK WORD(pRec& + 10)
  213. rPageB   = PEEK WORD(pRec& + 12)
  214. rPageR   = PEEK WORD(pRec& + 14)
  215. iFstPage = PEEK WORD(pRec& + 62)      :           ' First page to print (TPrJob)
  216. iLstPage = PEEK WORD(pRec& + 64)      :           ' Last page to print
  217. dummy&   = USR 7(PRHANDLE)            :           ' Unlock print record
  218.  
  219. pageWid  = rPageR - rPageL            :           ' Width of printable area
  220. pageLen  = rPageB - rPageT            :           ' Length of printable area
  221.  
  222. RETURN
  223. '_____________________________________________________________________________
  224.  
  225. "FontInfo"
  226.  
  227. CALL GETFNUM("Times",fNum)            :           ' Find the font number of this font
  228. fHeight = pageLen                     :           ' Set font size to page height
  229. face    = outline + condense          :           ' Calculate font face desired
  230. TEXT fNum,fHeight,face,1              :           ' Use desired font temporarily
  231. CALL GETFONTINFO(VARPTR(fAscent))     :           ' Get needed font information
  232.  
  233. WHILE fAscent + fDecent > pageLen     :           ' While font is too large to fit page
  234.   fHeight = fHeight - 1               :           '   Use font size 1 point smaller
  235.   TEXT ,fHeight                       :           '   Reset desired font size
  236.   CALL GETFONTINFO(VARPTR(fAscent))   :           '   Recheck font information
  237. WEND
  238.  
  239. stringLen = FN STRINGWIDTH(banner$) + 72 :        ' Get the string width and add some
  240. TEXT 4,9,0,0                          :           ' Restore the original font
  241.  
  242. RETURN
  243.